home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / mule / mule-charset.el.z / mule-charset.el
Encoding:
Text File  |  1998-05-21  |  4.5 KB  |  138 lines
  1. ;;; mule-charset.el --- Charset functions for Mule.
  2. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1995 Amdahl Corporation.
  4. ;; Copyright (C) 1996 Sun Microsystems.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  20. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21. ;; Boston, MA 02111-1307, USA.
  22.  
  23.  
  24. ;;;; Composite character support
  25.  
  26. (defun compose-region (start end &optional buffer)
  27.   "Compose characters in the current region into one composite character.
  28. From a Lisp program, pass two arguments, START to END.
  29. The composite character replaces the composed characters.
  30. BUFFER defaults to the current buffer if omitted."
  31.   (interactive "r")
  32.   (let ((ch (make-composite-char (buffer-substring start end buffer))))
  33.     (delete-region start end buffer)
  34.     (insert-char ch nil nil buffer)))
  35.  
  36. (defun decompose-region (start end &optional buffer)
  37.   "Decompose any composite characters in the current region.
  38. From a Lisp program, pass two arguments, START to END.
  39. This converts each composite character into one or more characters,
  40. the individual characters out of which the composite character was formed.
  41. Non-composite characters are left as-is.  BUFFER defaults to the current
  42. buffer if omitted."
  43.   (interactive "r")
  44.   (save-excursion
  45.     (set-buffer buffer)
  46.     (save-restriction
  47.       (narrow-to-region start end)
  48.       (goto-char (point-min))
  49.       (let ((compcharset (get-charset 'composite)))
  50.     (while (< (point) (point-max))
  51.       (let ((ch (char-after (point))))
  52.         (if (eq compcharset (char-charset ch))
  53.         (progn
  54.           (delete-char 1)
  55.           (insert (composite-char-string ch))))))))))
  56.  
  57.  
  58. ;;;; Classifying text according to charsets
  59.  
  60. (defun charsets-in-region (start end &optional buffer)
  61.   "Return a list of the charsets in the region between START and END.
  62. BUFFER defaults to the current buffer if omitted."
  63.   (let (list)
  64.     (save-excursion
  65.       (if buffer
  66.       (set-buffer buffer))
  67.       (save-restriction
  68.     (narrow-to-region start end)
  69.     (goto-char (point-min))
  70.     (while (not (eobp))
  71.       (let* (prev-charset
  72.          (ch (char-after (point)))
  73.          (charset (char-charset ch)))
  74.         (if (not (eq prev-charset charset))
  75.         (progn
  76.           (setq prev-charset charset)
  77.           (or (memq charset list)
  78.               (setq list (cons charset list))))))
  79.       (forward-char))))
  80.     list))
  81.  
  82. (defun charsets-in-string (string)
  83.   "Return a list of the charsets in STRING."
  84.   (let ((i 0)
  85.      (len (length string))
  86.      prev-charset charset list)
  87.     (while (< i len)
  88.       (setq charset (char-charset (aref string i)))
  89.       (if (not (eq prev-charset charset))
  90.        (progn
  91.          (setq prev-charset charset)
  92.          (or (memq charset list)
  93.          (setq list (cons charset list)))))
  94.       (setq i (1+ i)))
  95.     list))
  96.  
  97.  
  98. ;;;; Charset accessors
  99.  
  100. (defun charset-graphic (charset)
  101.   "Return the `graphic' property of CHARSET.
  102. See `make-charset'."
  103.   (charset-property charset 'graphic))
  104.  
  105. (defun charset-final (charset)
  106.   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
  107.   (charset-property charset 'final))
  108.  
  109. (defun charset-chars (charset)
  110.   "Return the number of characters per dimension of CHARSET."
  111.   (charset-property charset 'chars))
  112.  
  113. (defun charset-columns (charset)
  114.   "Return the number of display columns per character of CHARSET.
  115. This only applies to TTY mode (under X, the actual display width can
  116. be automatically determined)."
  117.   (charset-property charset 'columns))
  118.  
  119. (defun charset-direction (charset)
  120.   "Return the display direction (`l2r' or `r2l') of CHARSET."
  121.   (charset-property charset 'direction))
  122.  
  123. (defun charset-registry (charset)
  124.   "Return the registry of CHARSET.
  125. This is a regular expression matching the registry field of fonts
  126. that can display the characters in CHARSET."
  127.   (charset-property charset 'registry))
  128.  
  129. (defun charset-ccl-program (charset)
  130.   "Return the CCL program of CHARSET.
  131. See `make-charset'."
  132.   (charset-property charset 'ccl-program))
  133.  
  134. ;;;; Define setf methods for all settable Charset properties
  135.  
  136. (defsetf charset-registry    set-charset-registry)
  137. (defsetf charset-ccl-program set-charset-ccl-program)
  138.